home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / elist.src.archive / 000013_crash!kirk.safb.af.mil!BWILLS_Thu, 17 Jun 93 21:44:43 PST.msg < prev    next >
Text File  |  1993-08-31  |  5KB  |  149 lines
  1. Received: by bkhouse.cts.com (V1.16/Amiga)
  2.     id AA00000; Thu, 17 Jun 93 21:44:43 PST
  3. Received: from kirk.safb.af.mil by crash.cts.com with smtp
  4.     (Smail3.1.28.1 #15) id m0o6X94-0000tEC; Thu, 17 Jun 93 20:29 PDT
  5. Message-Id: <m0o6X94-0000tEC@crash.cts.com>
  6. Date: 17 Jun 93 22:27:00 CST
  7. From: "Barry D. Wills" <BWILLS@kirk.safb.af.mil>
  8. To: "amigae" <amigae@bkhouse.cts.com>
  9. Subject: 2Darray.e (solution)
  10.  
  11. I forget who originally asked this question.  Must have accidently deleted the
  12. message (sorry!)  But here it is:  2D arrays in E!  With a little more work this
  13. could be expanded into a MULTI-dimensional module (see my sscanf.e module for a
  14. hint :)  Later.  -- Barry
  15.  
  16. ---  CUT HERE  -------------------------------------------------------------
  17.  
  18. /*========================================================================*/
  19. /*                                                                        */
  20. /* 2D array in E.  It's as easy as this.                                  */
  21. /*                                                                        */
  22. /* User components are:                                                   */
  23. /*   dd_arrayType and the components therein                              */
  24. /*   dd_dim (), create the 2d array                                       */
  25. /*   dd_set (), put a value into an element of the 2d array               */
  26. /*   dd_get (), get a value from an element of the 2d array               */
  27. /*                                                                        */
  28. /* The other components of this module should not be useful.              */
  29. /*                                                                        */
  30. /*========================================================================*/
  31.  
  32.  
  33. RAISE 0 IF CtrlC () = TRUE
  34. /* You should define an error trap for New()=NIL. */
  35.  
  36.  
  37. OBJECT dd_arrayType
  38.   iUBound, jUBound, elSize, elements
  39. ENDOBJECT
  40.  
  41.  
  42. /* These are global to speed up array access. */
  43. DEF dd_ar : PTR TO dd_arrayType,
  44.     dd_charPtr : PTR TO CHAR,
  45.     dd_intPtr : PTR TO INT,
  46.     dd_longPtr : PTR TO LONG,
  47.     dd_elSize
  48.  
  49.  
  50. PROC dd_dim (i, j, elSize)
  51.   IF (elSize <> 1) AND
  52.      (elSize <> 2) AND
  53.      (elSize <> 4) THEN Raise ('Invalid element size.')
  54.   dd_ar := New (SIZEOF dd_arrayType)
  55.   dd_ar.elements := New (i*j*elSize)
  56.   dd_ar.iUBound := i - 1
  57.   dd_ar.jUBound := j - 1
  58.   dd_ar.elSize := elSize
  59. ENDPROC  dd_ar
  60.  
  61.  
  62. PROC checkBounds (i, j)
  63.   /* dd_ar already points to array when this is called. */
  64.   IF (i < 0) OR (i > dd_ar.iUBound) THEN Raise ('"i" subscript out of bounds.')
  65.   IF (j < 0) OR (j > dd_ar.jUBound) THEN Raise ('"j" subscript out of bounds.')
  66. ENDPROC  TRUE
  67.  
  68.  
  69. PROC dd_offset (i, j) RETURN ((i * (dd_ar.jUBound + 1) + j) * dd_elSize)
  70.  
  71.  
  72. PROC dd_set (array, i, j, value)
  73.   dd_ar := array
  74.   checkBounds (i, j)
  75.   dd_elSize := dd_ar.elSize
  76.   SELECT dd_elSize
  77.     CASE 1
  78.       dd_charPtr := dd_ar.elements
  79.       dd_charPtr [dd_offset (i, j)] := value
  80.     CASE 2
  81.       dd_intPtr := dd_ar.elements
  82.       dd_intPtr [dd_offset (i, j)] := value
  83.     CASE 4
  84.       dd_longPtr := dd_ar.elements
  85.       dd_longPtr [dd_offset (i, j)] := value
  86.   ENDSELECT
  87. ENDPROC
  88.  
  89.  
  90. PROC dd_get (array, i, j)
  91.   DEF value
  92.   dd_ar := array
  93.   checkBounds (i, j)
  94.   dd_elSize := dd_ar.elSize
  95.   SELECT dd_elSize
  96.     CASE 1
  97.       dd_charPtr := dd_ar.elements
  98.       value := dd_charPtr [dd_offset (i, j)]
  99.     CASE 2
  100.       dd_intPtr := dd_ar.elements
  101.       value := dd_intPtr [dd_offset (i, j)]
  102.     CASE 3
  103.       dd_longPtr := dd_ar.elements
  104.       value := dd_longPtr [dd_offset (i, j)]
  105.   ENDSELECT
  106. ENDPROC  value
  107.  
  108.  
  109. PROC dd_dispose (array)
  110.   dd_ar := array
  111.   Dispose (dd_ar.elements)
  112.   Dispose (dd_ar)
  113. ENDPROC
  114.  
  115.  
  116. PROC main () HANDLE
  117.   DEF myArray : PTR TO dd_arrayType,  /* Only needs to PTR TO if you want */
  118.                                       /* access to the OBJECT fields.     */
  119.       xDim = 4, yDim = 4,             /* x and y dimensions.              */
  120.       sizeofChar = 1,                 /* Just for readability.            */
  121.       i, j, val = 0                   /* Loop counters.                   */
  122.  
  123.   /* Create the array. */
  124.   myArray := dd_dim (xDim, yDim, sizeofChar)
  125.  
  126.   /* Put stuff in each element. */
  127.   FOR i := 0 TO myArray.iUBound
  128.     FOR j := 0 TO myArray.jUBound
  129.       CtrlC()
  130.       dd_set (myArray, i, j, val++)
  131.     ENDFOR
  132.   ENDFOR
  133.  
  134.   /* Get it back out. */
  135.   FOR i := 0 TO myArray.iUBound
  136.     FOR j := 0 TO myArray.jUBound
  137.       WriteF ('myArray [\d,\d]=\d\n', i, j, dd_get (myArray, i, j))
  138.     ENDFOR
  139.   ENDFOR
  140.  
  141.   /* Cleanup. */
  142.   dd_dispose (myArray)
  143.  
  144. EXCEPT
  145.   IF exception THEN WriteF ('\s\n', exception)
  146.   CleanUp (exception)
  147. ENDPROC
  148.  
  149. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%